home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / mat.vec < prev    next >
Text File  |  1995-03-23  |  8KB  |  405 lines

  1. This file contains some programs which handle with arrays and lists.
  2.  
  3. Short decsription:
  4. ------------------
  5.  
  6. A<-->L   array to list and reverse
  7.  
  8.          This program converts an array to the corresponding list and
  9.          viceversa, eg:
  10.  
  11.          [[ 1 2 ]          {{ 1 2 }
  12.           [ 3 4 ]    <-->   { 3 4 }
  13.           [ 5 6 ]           { 5 6 }}
  14.  
  15.           [ 3.5 -8 ]    <-->   { 3.5 -8 }
  16.  
  17.          The format of the list must of course "looks" like an array, say
  18.          a list of list of numbers, each sublist with the same length.
  19.  
  20.  
  21.  
  22. trn      Transponse
  23.  
  24.          A generic transpose function for matrices and lists. The list must have
  25.          the format of a n*m-matrix, but is allowed to contain any object.
  26.  
  27.  
  28.          {{   'foo'    'bar' 1.234 }          {{ 'foo' << swap >> }
  29.           { << swap >>  { }   "!"  }}  <-->    {  { }    'bar'    }
  30.                                                {  "!"    1.234    }}
  31.  
  32.  
  33. MOP      Matrix Operation
  34.  
  35.          Revised 'MOP' (Matrix OPeration): A program, which executes any
  36.          algebraic  operation or program on every element of an 1 or 2
  37.          dimensional array.
  38.  
  39.          usage:
  40.          ======
  41.  
  42.          2:                <array>
  43.          1:   <algebraic function>  or  <program>
  44.          MOP
  45.  
  46.          2:        <name of array>
  47.          1:   <algebraic function>  or  <program>
  48.          MOP
  49.  
  50.  
  51.          e.g.:
  52.          =====
  53.  
  54.          2:         [[  1  2.3 ]
  55.                      [ -3  4.4 ]
  56.                      [  1 -1.1 ]]
  57.          1:       'LOG(SQR(X))-3'
  58.          MOP
  59.  
  60.  
  61.          2:         [[  1  2.3 ]
  62.                      [ -3  4.4 ]
  63.                      [  1 -1.1 ]]
  64.          1: << IF X 1 < THEN X DUP R->C ELSE X END >>
  65.          MOP
  66.  
  67.  
  68.          2:               '&DAT'
  69.          1:             'INV(X)'
  70.          MOP
  71.  
  72.  
  73.          2:               '&DAT'
  74.          1:          << X INV >>
  75.          MOP
  76.  
  77.          The algebraic operation must have 'x' as argument. I know, this
  78.          sucks, but calling by reference like  'MOP(INV(<array>)*3-2)'  is
  79.          not possible (or does anybody know a way ??)
  80.          & := the Sigma-sign
  81.  
  82.          The name 'MOP' was created by Schrulli B.  thanx ;-)
  83.  
  84.  
  85.  
  86. V<-->M   vector to matrix and reverse
  87.  
  88.          Converts a vector to a matrix and viceversa.
  89.  
  90.          [ -9  2.3  4 ]    <--->    [[ -9  2.3  4 ]]
  91.  
  92.  
  93.  
  94. M->V     matrix to vectors
  95.  
  96.          Another "OBJ->" command. It puts all vectors of a matrix to the stack:
  97.  
  98.          [[  1  2.3 ]                [  1  2.3 ]
  99.           [ -3  4.4 ]     --->       [ -3  4.4 ]
  100.           [  1 -1.1 ]]               [  1 -1.1 ]
  101.                                                3
  102.  
  103.  
  104. V->M     vectors to matrix
  105.  
  106.          The corresponding function to  M->V  It takes n vectors from the stack
  107.          and builds one matrix.
  108.  
  109.  
  110.          [  1  2.3 ]                [[  1  2.3 ]
  111.          [ -3  4.4 ]      --->       [ -3  4.4 ]
  112.          [  1 -1.1 ]                 [  1 -1.1 ]]
  113.                    3
  114.  
  115.  
  116.  
  117. GETR     get a row from a matrix
  118.  
  119.          [[  1  2.3 ]
  120.           [ -3  4.4 ]     --->       [  1  2.3 ]
  121.           [  1 -1.1 ]]
  122.                      1
  123.  
  124.  
  125.  
  126. GETC     get a column from a matrix
  127.  
  128.          [[  1  2.3 ]               [[  1 ]
  129.           [ -3  4.4 ]     --->       [ -3 ]
  130.           [  1 -1.1 ]]               [  1 ]]
  131.                      1
  132.  
  133.  
  134.  
  135. DELR     delete a row from a matrix
  136.  
  137.          [[  1  2.3 ]
  138.           [ -3  4.4 ]     --->   [[ -3  4.4 ]
  139.           [  1 -1.1 ]]            [  1 -1.1 ]]
  140.                      1
  141.  
  142.  
  143.  
  144. DELC     delete a collumn from a matrix
  145.  
  146.          [[  1  2.3 ]             [[  2.3 ]
  147.           [ -3  4.4 ]     --->     [  4.4 ]
  148.           [  1 -1.1 ]]             [ -1.1 ]]
  149.                      1
  150.  
  151.  
  152. PUTR     put a row to a matrix
  153.  
  154.          Inserts or overwrites a vector into a matrix as a row.
  155.          A positive row-number indicates inserting, a negative overwriting.
  156.  
  157.  
  158.          [[  1  2.3 ]             [[  0   0  ]
  159.           [ -3  4.4 ]              [  1  2.3 ]
  160.           [  1 -1.1 ]]    --->     [ -3  4.4 ]
  161.                      1             [  1 -1.1 ]]
  162.                [ 0 0 ]
  163.  
  164.  
  165.          [[  1  2.3 ]             [[  0   0  ]
  166.           [ -3  4.4 ]     --->     [ -3  4.4 ]
  167.           [  1 -1.1 ]]             [  1 -1.1 ]]
  168.                     -1
  169.                [ 0 0 ]
  170.  
  171.  
  172.  
  173.  
  174. PUTC     put a column to a matrix
  175.  
  176.          Inserts or overwrites a vector into a matrix as a column.
  177.          A positive column-number indicates inserting, a negative overwriting.
  178.  
  179.  
  180.          [[  1  2.3 ]            [[ 0  1  2.3 ]
  181.           [ -3  4.4 ]     --->    [ 0 -3  4.4 ]
  182.           [  1 -1.1 ]]            [ 0  1 -1.1 ]]
  183.                      1
  184.              [ 0 0 0 ]
  185.  
  186.  
  187.          [[  1  2.3 ]             [[ 0   0  ]
  188.           [ -3  4.4 ]     --->     [ 0  4.4 ]
  189.           [  1 -1.1 ]]             [ 0 -1.1 ]]
  190.                     -1
  191.              [ 0 0 0 ]
  192.  
  193.  
  194.  
  195.  -----------------------------------------------------------------------------
  196. | General Student Board | asta@rz.uni-ulm.de   | asta@rz.uni-ulm.dbp.de       |
  197. | c/o Ulli Horlacher    | asta@dulruu51.bitnet | 50184::asta  (DECnet/BelWUe) |
  198. | University of Ulm     | ----------------------------------------------------|
  199. | D-7900 Ulm, Germany   |        "Waiting for the prompt" -Marillion          |
  200.  -----------------------------------------------------------------------------
  201.  
  202.  
  203. %%HP: T(3)A(D)F(.);
  204. DIR
  205.   DELC
  206.     \<< SWAP trn SWAP
  207. DELR trn
  208.     \>>
  209.   DELR
  210.     \<< \-> a
  211.       \<< M\->V DUP a -
  212. 2 + ROLL DROP 1 -
  213. V\->M
  214.       \>>
  215.     \>>
  216.   PUTC
  217.     \<< ROT trn ROT
  218. ROT PUTR trn
  219.     \>>
  220.   PUTR
  221.     \<< \-> a v
  222.       \<< M\->V
  223.         IF a 0 <
  224.         THEN DUP a
  225. + 2 + ROLL DROP v
  226. OVER a + 2 + ROLLD
  227.         ELSE v OVER
  228. a - 3 + ROLLD 1 +
  229.         END V\->M
  230.       \>>
  231.     \>>
  232.   V\->M
  233.     \<< OVER SIZE 1
  234. GET \-> n m
  235.       \<< 0 n 1 -
  236.         FOR i i m *
  237. n i - + ROLL OBJ\->
  238. DROP
  239.         NEXT n m 2
  240. \->LIST \->ARRY
  241.       \>>
  242.     \>>
  243.   M\->V
  244.     \<< OBJ\-> OBJ\->
  245. DROP \-> n m
  246.       \<< 1 n
  247.         FOR i m 1
  248. \->LIST \->ARRY n i - m
  249. * i + ROLLD
  250.         NEXT n
  251.       \>>
  252.     \>>
  253.   GETR
  254.     \<< \-> r
  255.       \<< M\->V DUP r -
  256. 2 + PICK \-> a
  257.         \<< DROPN a
  258.         \>>
  259.       \>>
  260.     \>>
  261.   GETC
  262.     \<< SWAP TRN SWAP
  263. GETR trn
  264.     \>>
  265.   CST { A\<-\->L trn
  266. MOP V\<-\->M V\->M M\->V
  267. GETR GETC PUTR PUTC
  268. DELR DELC }
  269.   A\<-\->L
  270.     \<<
  271.       IF DUP TYPE 5
  272. ==
  273.       THEN
  274.         IF DUP 1
  275. GET TYPE 5 ==
  276.         THEN \-> a
  277.           \<< 1 a
  278. SIZE
  279.             FOR i a
  280. i GET OBJ\-> 1 \->LIST
  281. \->ARRY
  282.             NEXT a
  283. SIZE V\->M
  284.           \>>
  285.         ELSE OBJ\-> 1
  286. \->LIST \->ARRY
  287.         END
  288.       ELSE
  289.         IF DUP SIZE
  290. SIZE 2 ==
  291.         THEN M\->V {
  292. } SWAP 1
  293.           FOR i i 1
  294. + ROLL OBJ\-> 1 GET
  295. \->LIST 1 \->LIST + -1
  296.           STEP
  297.         ELSE OBJ\-> 1
  298. GET \->LIST
  299.         END
  300.       END
  301.     \>>
  302.   trn
  303.     \<<
  304.       IF DUP TYPE 5
  305. ==
  306.       THEN
  307.         IF DUP 1
  308. GET TYPE 5 \=/
  309.         THEN 1
  310. \->LIST
  311.         END DUP
  312. SIZE OVER 1 GET
  313. SIZE \-> l n m
  314.         \<< 1 m
  315.           FOR i 1 n
  316.             FOR j l
  317. j GET i GET
  318.             NEXT n
  319. \->LIST
  320.           NEXT m
  321. \->LIST
  322.         \>>
  323.         IF DUP SIZE
  324. 1 == OVER 1 GET
  325. TYPE 5 == AND
  326.         THEN OBJ\->
  327. DROP
  328.         END
  329.       ELSE
  330.         IF DUP SIZE
  331. SIZE 1 ==
  332.         THEN V\<-\->M
  333.         END TRN
  334.         IF DUP SIZE
  335. 1 GET 1 ==
  336.         THEN V\<-\->M
  337.         END
  338.       END
  339.     \>>
  340.   MOP
  341.     \<< 1 CF DEPTH
  342. \->LIST DUP \-> s
  343.       \<< LIST\-> DROP
  344. \-> a o
  345.         \<< a DUP
  346.           IFERR RCL
  347. 1 SF SWAP DROP
  348.           THEN
  349.           END 1
  350. OVER SIZE LIST\-> 1 -
  351.           IF
  352.           THEN *
  353.           END
  354.           IFERR
  355.             FOR i
  356.               IF 1
  357. FS?
  358.               THEN
  359. a
  360.               END i
  361. OVER i GET 'X' STO
  362. o EVAL
  363.               IFERR
  364. PUT
  365.               THEN
  366. ROT (1,0) * ROT ROT
  367. PUT
  368.               END
  369.             NEXT
  370.           THEN
  371. DROP2 'X' PURGE
  372.             IF 1
  373. FS?
  374.             THEN
  375. STO
  376.             ELSE
  377. DROP
  378.             END
  379. CLEAR s LIST\-> DROP
  380. "MOP Error:
  381. " ERRM
  382. + DOERR
  383.           ELSE
  384.             IF 1
  385. FC?
  386.             THEN
  387. SWAP
  388.             END
  389. DROP
  390.           END 1 CF
  391. 'X' PURGE
  392.         \>>
  393.       \>>
  394.     \>>
  395.   V\<-\->M
  396.     \<<
  397.       IF DUP SIZE
  398. SIZE 1 ==
  399.       THEN 1 V\->M
  400.       ELSE M\->V DROP
  401.       END
  402.     \>>
  403. END
  404.  
  405.